home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / music / oscbas.arj / OSC.BAS < prev    next >
BASIC Source File  |  1994-05-11  |  5KB  |  188 lines
  1. DEFINT A-Z
  2.  
  3. DECLARE SUB Screen13 ()
  4. DECLARE SUB ScreenEnd ()
  5.  
  6.     CONST BPORT = &H220  'Base Port address
  7.     CONST XPORT = &H226  'Reset port address
  8.     CONST WPORT = &H22C  'Write port address
  9.     CONST RPORT = &H22A  'Read port address
  10.     CONST APORT = &H22E  'Data Available port address
  11.     
  12.     Screen13
  13.  
  14.     DIM xx(255), xx3(255)
  15.     
  16.     FOR r = 0 TO 63
  17.             xx(r) = r
  18.             xx(r + 64) = 63 - r
  19.     NEXT
  20.  
  21.     FOR r = 0 TO 31
  22.             xx3(r) = r * 2
  23.             xx3(r + 32) = (31 - r) * 2
  24.             xx3(r + 128) = r * 2
  25.             xx3(r + 160) = (31 - r) * 2
  26.     NEXT
  27.  
  28.     FOR r = 0 TO 255
  29.         xx(r) = xx(r) + 20
  30.         xx3(r) = xx3(r) + 20
  31.     NEXT
  32.     
  33.     os1 = 0
  34.     os3 = 0
  35.     x1m = 1
  36.     x3m = -1
  37.  
  38.     OUT &H3C8, 0
  39.     FOR r = 0 TO 254
  40.         OUT &H3C9, 0
  41.         OUT &H3C9, 0
  42.         OUT &H3C9, 0
  43.     NEXT
  44.     
  45.     DEF SEG = &HA000
  46.  
  47.     x$ = SPACE$(16000)
  48.     x2$ = SPACE$(16000)
  49.  
  50.     OUT XPORT, &H1
  51.     FOR r = 1 TO 20: NEXT
  52.     OUT XPORT, &H0
  53.     FOR r = 1 TO 20: NEXT
  54.  
  55.     c = 1
  56.     ltot = 0
  57.     pa0 = 0     'previous above zero
  58.     ca0 = 0     'current above zero
  59.     lzc = 0
  60.     top = 0
  61.     gon = 0
  62.  
  63.     bc1 = 1
  64.     bc2 = 32
  65.     bc3 = 1
  66.  
  67.     
  68. newimag:
  69.     gon = gon + 1
  70.     IF gon = 4 THEN gon = 1
  71.     zc = 0
  72.     at = 0
  73.     tot = 0
  74.     js = 1      'just switched
  75.     rs = 0
  76.     CALL fopen("osc.dat", hand)
  77.     
  78.     goin& = ((gon - 1) * 64000) + 5000
  79.     CALL fseek(hand, goin&)
  80.  
  81.     CALL fget(hand, x$)
  82.     CALL bcopy(SSEG(x$), SADD(x$), &HA000, 0, 16000, 0)
  83.  
  84.     CALL fget(hand, x$)
  85.     toadd& = 16000
  86.     CALL bcopy(SSEG(x$), SADD(x$), &HA000, toadd&, 16000, 0)
  87.  
  88.     CALL fget(hand, x2$)
  89.     toadd& = 32000
  90.     CALL bcopy(SSEG(x2$), SADD(x2$), &HA000, toadd&, 16000, 0)
  91.  
  92.     CALL fget(hand, x$)
  93.     toadd& = 48000
  94.     CALL bcopy(SSEG(x$), SADD(x$), &HA000, toadd&, 16000, 0)
  95.  
  96.     CALL fseek(hand, goin& + 16000)
  97.     CALL fget(hand, x$)
  98.  
  99.     CALL fclose(hand)
  100.  
  101.     maxzc = 1       'maximum zero count for interactive freq. counter
  102.     tbzc = 0        'times below zero counter - for adaption.
  103.  
  104.     DO
  105.         OUT WPORT, &H20           'Tell SoundBlaster you wanna read a byte.
  106.         gotit = INP(RPORT)
  107.         IF gotit > 253 OR gotit < 2 THEN top = 63
  108.         gg = (gotit - 128)
  109.         IF gg > 5 THEN ca0 = 1 ELSE IF gg < -5 THEN ca0 = -1
  110.         IF pa0 <> ca0 THEN
  111.             zc = zc + 1
  112.         END IF
  113.         pa0 = ca0
  114.  
  115.         gg = ABS(gg)
  116.         tot = tot + gg
  117.         at = at + 1
  118.         
  119.         IF at = 320 THEN
  120.             tot = tot \ 512
  121.  
  122.             tot = (tot + tot + ltot) \ 3
  123.             zc = (zc + zc + lzc) \ 3
  124.             IF zc > maxzc THEN
  125.                 maxzc = zc
  126.                 tbzc = 0
  127.             ELSEIF zc < (maxzx - 5) THEN
  128.                 tbzc = tbzc + 1
  129.                 IF tbzc > 25 THEN
  130.                     maxzc = maxzc - 1
  131.                     IF maxzc = 0 THEN maxzc = 1
  132.                     tbzc = 0
  133.                 END IF
  134.             END IF
  135.             
  136.             IF zc THEN
  137.                 js = 0
  138.                 rs = 0
  139.             END IF
  140.  
  141.             bc1 = bc1 + 1
  142.             bc2 = bc2 + 2
  143.             bc3 = bc3 + 3
  144.  
  145.             IF (zc = 0 AND js = 0) THEN rs = rs + 1
  146.             IF rs >= 17 THEN GOTO newimag
  147.             
  148.             CALL bcopy(SSEG(x$), SADD(x$), &HA000, 16000, 16000, 0)
  149.             CALL bcopy(SSEG(x2$), SADD(x2$), &HA000, 32000, 16000, 0)
  150.  
  151.             OUT &H3C8, 0
  152.             top = top - 5
  153.             IF top < 0 THEN top = 0
  154.             OUT &H3C9, top
  155.             OUT &H3C9, top
  156.             OUT &H3C9, top
  157.             FOR r = 1 TO 254
  158.                 rr1 = ABS((r + os1) MOD 255)
  159.                 rr3 = ABS((r + os3) MOD 255)
  160.                 c1 = (((xx(rr1) * zc + 2) \ maxzc) * tot) \ 30
  161.                 xx = (maxzc - zc)
  162.                 IF xx < 0 THEN xx = 0
  163.                 c3 = (((xx3(rr3) * xx + 2) \ maxzc) * tot) \ 30
  164.                 IF c1 > 63 THEN c1 = 63 ELSE IF c1 < 0 THEN c1 = 0
  165.                 IF c3 > 63 THEN c3 = 63 ELSE IF c3 < 0 THEN c3 = 0
  166.                 OUT &H3C9, c1
  167.                 OUT &H3C9, 0
  168.                 OUT &H3C9, c3
  169.             NEXT
  170.             OUT &H3C9, bc1
  171.             OUT &H3C9, bc2
  172.             OUT &H3C9, bc3
  173.             
  174.             os1 = os1 + x1m
  175.             os3 = os3 + x3m
  176.  
  177.             zc = 0
  178.             at = 0
  179.             tot = 0
  180.         END IF
  181.         gotit = gotit + 150
  182.         POKE ((gotit \ 3) * 320 + at), 255
  183.     LOOP UNTIL INP(&H60) = 1    'esc pressed
  184.  
  185.     ScreenEnd
  186.     END
  187.  
  188.